home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Merciful 2
/
Merciful - Disc 2.iso
/
software
/
h
/
highspeedpascalv2.0a.dms
/
highspeedpascalv2.0a.adf
/
HSPascal
/
AmigaDemos
/
Speech.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-01-16
|
5KB
|
188 lines
{--------------------------------------------------------------------------
HighSpeed Pascal for the Amiga
SPEECH SYNTH INTERFACE
Programmed by Martin Eskildsen 1991
Copyright (c) 1991 by D-House I ApS
All rights reserved
Version : Date (dd.mm.yy) : Comment
-----------------------------------
1.00 : 06.11.91 : First version
1.01 : 16.12.91 : Updated for final Amiga unit
--------------------------------------------------------------------------}
unit Speech;
INTERFACE
uses Narrator, Translator, Exec, Amiga;
type
Parameters = (PitchParam, VolumeParam, SexParam, RateParam, ModeParam,
FreqParam);
ParamSet = set of Parameters;
Sex = (male, female);
Mode = (human, robot);
PitchRange = MINPITCH..MAXPITCH;
VolumeRange = MINVOL..MAXVOL;
FreqRange = MINFREQ..MAXFREQ;
RateRange = MINRATE..MAXRATE;
function OpenSpeech : boolean; { TRUE = success }
procedure CloseSpeech;
procedure Say(s : string);
procedure SetFrequency(n : FreqRange);
procedure SetRate (n : RateRange);
procedure SetPitch (n : PitchRange);
procedure SetMode (n : Mode);
procedure SetSex (n : Sex);
procedure SetVolume (n : VolumeRange);
procedure DefaultParameters(p : ParamSet);
IMPLEMENTATION
const
AudioChannelMasks : array [1..4] of byte = (3, 5, 10, 12);
type
pNarrator_rb = ^tNarrator_rb;
var
writeNarrator : pNarrator_rb;
writePort : pMsgPort;
output_buf : packed array [0..2047] of char;
SpeechLive : boolean; { TRUE = speech is opened }
function OpenSpeech : boolean;
label 1; { Oh yes, labels are "allowed" when sensible! }
const Revision = 0;
procedure CloseDown;
begin
if TranslatorBase <> NIL then CloseLibrary(pLibrary(TranslatorBase));
if writePort^.mp_sigbit <> -1 then DeletePort(writePort);
if writeNarrator <> NIL then begin
CloseDevice(pIORequest(writeNarrator));
DeleteExtIO(pIORequest(writeNarrator))
end
end;
begin
if SpeechLive then goto 1; { Get out of here if open }
SpeechLive := FALSE; { Default state in case something goes wrong }
FillChar(output_buf, sizeof(output_buf), #0); { Empty buffer }
TranslatorBase := pLibrary(OpenLibrary('translator.library', Revision));
if TranslatorBase = NIL then begin { Abort if error }
CloseDown;
goto 1
end;
writePort := CreatePort(NIL,0);
writeNarrator := pNarrator_rb(CreateExtIO(writePort, sizeof(tNarrator_rb)));
with writeNarrator^ do begin
ch_masks := @AudioChannelMasks; { Audio channes to use }
nm_masks := sizeof(AudioChannelMasks); { Number of channels }
mouths := 0; { No mouth }
with message do begin
IO_data := @output_buf; { Where to get data from }
IO_command := CMD_WRITE; { This is a Write block }
IO_offset := 0;
IO_length := 1 { Only one char right now }
end { ( = #0 ) }
end;
if OpenDevice('narrator.device', 0, pIORequest(writeNarrator), 0) <> 0 then begin
CloseDown;
goto 1
end;
DefaultParameters([SexParam, RateParam, VolumeParam, PitchParam,
FreqParam, ModeParam]);
SpeechLive := TRUE; { Success! }
1: { Where to go if problems }
OpenSpeech := SpeechLive
end;
procedure CloseSpeech;
begin
if SpeechLive then begin
CloseLibrary(pLibrary(TranslatorBase));
DeletePort(writePort);
CloseDevice(pIORequest(writeNarrator));
DeleteExtIO(pIORequest(writeNarrator));
SpeechLive := FALSE
end
end;
procedure Say(s : string);
var
return : longint;
i : integer;
begin
s := s + #0;
return := Translate(@s[1], length(s), @output_buf, sizeof(output_buf) - 1);
i := 0; while output_buf[i] <> #0 do inc(i); { C str. length }
writeNarrator^.message.IO_length := i;
return := DoIO(pIORequest(writeNarrator))
end;
procedure SetFrequency(n : FreqRange);
begin
writeNarrator^.sampfreq := n
end;
procedure SetRate(n : RateRange);
begin
writeNarrator^.rate := n
end;
procedure SetPitch(n : PitchRange);
begin
writeNarrator^.pitch := n
end;
procedure SetMode(n : Mode);
begin
writeNarrator^.mode := ord(n) { Trick! As n is an enumerated type }
end; { it has values 0 and 1 which are }
{ the same values as NATURALF0 (0) }
{ and ROBOTICF0 (1), so all we need }
{ is to construct our subrange proper-}
{ ly (human, robot) }
procedure SetSex(n : Sex);
begin
writeNarrator^.sex := ord(n) { As above }
end;
procedure SetVolume(n : VolumeRange);
begin
writeNarrator^.volume := n
end;
procedure DefaultParameters(p : ParamSet);
begin
if SexParam in p then SetSex (male);
if VolumeParam in p then SetVolume (DEFVOL);
if RateParam in p then SetRate (DEFRATE);
if ModeParam in p then SetMode (human);
if PitchParam in p then SetPitch (DEFPITCH);
if FreqParam in p then SetFrequency(DEFFREQ)
end;
begin
writeNarrator := NIL;
SpeechLive := FALSE
end.